perm filename PUZZL2.LSP[W78,JMC] blob sn#336406 filedate 1978-02-19 generic text, type T, neo UTF8
(comment These functions solve the following puzzle  Mr S and Mr P
are jointly told that two numbers 1 < m, n < 100 will be chosen and that
Mr S will be told  m + n  and Mr P will be told  m * n  This is done,
and the following truthful conversation occurs between the two mathematicians

Mr P - I don't know the numbers

Mr S - I knew you didn't know them  I don't know them either

Mr P - Now I know them

Mr S - Now I know them too

What were the numbers?

The program is based on the following considerations  (1) m+n cannot
be larger than 54 unless it is 197 or 198, because it could otherwise
be represented as a sum one of whose terms is a prime q with 50 < q < 100,
in which case Mr S could not be sure that Mr P didn't know the numbers
197 and 198 are eliminated because Mr S would be able to deduce the
numbers  (2) The m+n also cannot be the sum of two primes, because if
it were, Mr S again could not be sure that Mr P didn't know m and n
By Goldbach's conjecture, which has been experimentally
verified far beyond the numbers occurring in this problem,
this excludes even m+n ≥ 6  It likewise excludes odd numbers which
of the form <prime> + 2  This leaves 11 possible values for m+n,
namely l = {11, 17, 23, 27, 29, 35, 37, 41, 47, 51, 53}
(3) Mr P can exclude any pair (m,n) whose sum does not belong to l,
and since this gives him the answer, there must be exactly one such
pair consistent with m*n  Since Mr S also knows the answer after
Mr P has announced his knowledge, m+n must be such that only one
of its partitions gives exactly one possibility for Mr P  The
answer turns out to be (4,13))

(SETQ BASE (SETQ IBASE 10.)) 

(SETQ L '(11. 17. 23. 27. 29. 35. 37. 41. 47. 51. 53.)) 

(DEFUN FACTORS (M) (FACTORS1 M 2.)) 

(DEFUN FACTORS1 (M N) 
       (COND ((EQUAL M N) NIL)
	     ((LESSP (QUOTIENT M N) N) NIL)
	     ((ZEROP (REMAINDER M N))
	      (CONS (LIST N (QUOTIENT M N)) (FACTORS1 M (ADD1 N))))
	     (T (FACTORS1 M (ADD1 N))))) 

(DEFUN SUMS (M) (SUMS1 M 2.)) 

(DEFUN SUMS1 (M N) 
       (COND ((GREATERP N (DIFFERENCE M N)) NIL)
	     (T (CONS (LIST N (DIFFERENCE M N)) (SUMS1 M (ADD1 N))))))
 

(DEFUN SPREAD (M) 
       (MAPCAR (FUNCTION (LAMBDA (U) 
				 (PICK (FACTORS (TIMES (CAR U)
						       (CADR U))))))
	       (SUMS M))) 

(DEFUN PICK (U) 
       (COND ((NULL U) NIL)
	     ((MEMBER (PLUS (CAAR U) (CADAR U)) L)
	      (CONS (CAR U) (PICK (CDR U))))
	     (T (PICK (CDR U))))) 

(DEFUN CHOOSE (U) 
       (COND ((NULL U) NIL)
	     ((EQUAL 1. (LENGTH (CAR U)))
	      (CONS (CAAR U) (CHOOSE (CDR U))))
	     (T (CHOOSE (CDR U))))) 


(DEFUN SOLVE NIL 
       (CAR (CHOOSE (MAPCAR (FUNCTION (LAMBDA (M) 
					      (CHOOSE (SPREAD M))))
			    L))))